home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / src / pt-misc.cc < prev    next >
C/C++ Source or Header  |  1997-03-07  |  11KB  |  626 lines
  1. /*
  2.  
  3. Copyright (C) 1996 John W. Eaton
  4.  
  5. This file is part of Octave.
  6.  
  7. Octave is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. Octave is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with Octave; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20.  
  21. */
  22.  
  23. #if defined (__GNUG__)
  24. #pragma implementation
  25. #endif
  26.  
  27. #ifdef HAVE_CONFIG_H
  28. #include <config.h>
  29. #endif
  30.  
  31. #include <iostream.h>
  32.  
  33. #ifdef HAVE_UNISTD_H
  34. #ifdef HAVE_SYS_TYPES_H
  35. #include <sys/types.h>
  36. #endif
  37. #include <unistd.h>
  38. #endif
  39.  
  40. #include "error.h"
  41. #include "input.h"
  42. #include "oct-obj.h"
  43. #include "pager.h"
  44. #include "toplev.h"
  45. #include "pt-cmd.h"
  46. #include "pt-exp.h"
  47. #include "pt-fcn.h"
  48. #include "pt-fvc.h"
  49. #include "pt-misc.h"
  50. #include "pt-mvr.h"
  51. #include "pt-walk.h"
  52. #include "pt-pr-code.h"
  53. #include "ov.h"
  54. #include "variables.h"
  55.  
  56. // Nonzero means we're breaking out of a loop or function body.
  57. extern int breaking;
  58.  
  59. // Nonzero means we're jumping to the end of a loop.
  60. extern int continuing;
  61.  
  62. // Nonzero means we're returning from a function.
  63. extern int returning;
  64.  
  65. // A list of commands to be executed.
  66.  
  67. tree_statement::~tree_statement (void)
  68. {
  69.   delete cmd;
  70.   delete expr;
  71. }
  72.  
  73. int
  74. tree_statement::line (void)
  75. {
  76.   return cmd ? cmd->line () : (expr ? expr->line () : -1);
  77. }
  78.  
  79. int
  80. tree_statement::column (void)
  81. {
  82.   return cmd ? cmd->column () : (expr ? expr->column () : -1);
  83. }
  84.  
  85. void
  86. tree_statement::maybe_echo_code (bool in_function_body)
  87. {
  88.   if (in_function_body
  89.       && (Vecho_executing_commands & ECHO_FUNCTIONS))
  90.     {
  91.       tree_print_code tpc (octave_stdout, Vps4);
  92.  
  93.       accept (tpc);
  94.     }
  95. }
  96.  
  97. void
  98. tree_statement::accept (tree_walker& tw)
  99. {
  100.   tw.visit_statement (*this);
  101. }
  102.  
  103. octave_value
  104. tree_statement_list::eval (bool print)
  105. {
  106.   bool pf;
  107.   octave_value retval;
  108.  
  109.   if (error_state)
  110.     return retval;
  111.  
  112.   for (Pix p = first (); p != 0; next (p))
  113.     {
  114.       tree_statement *elt = this->operator () (p);
  115.  
  116.       if (! print)
  117.     pf = false;
  118.       else
  119.     pf = elt->print_flag;
  120.  
  121.       tree_command *cmd = elt->command ();
  122.       tree_expression *expr = elt->expression ();
  123.  
  124.       if (cmd || expr)
  125.     {
  126.       elt->maybe_echo_code (function_body);
  127.  
  128.       if (cmd)
  129.         cmd->eval ();
  130.       else
  131.         retval = expr->eval (pf);
  132.  
  133.       if (error_state)
  134.         return octave_value ();
  135.  
  136.       if (breaking || continuing)
  137.         break;
  138.  
  139.       if (returning)
  140.         break;
  141.     }
  142.       else
  143.     retval = octave_value ();
  144.     }
  145.   return retval;
  146. }
  147.  
  148. octave_value_list
  149. tree_statement_list::eval (bool print, int nargout)
  150. {
  151.   octave_value_list retval;
  152.  
  153.   if (nargout > 1)
  154.     {
  155.       bool pf;
  156.  
  157.       if (error_state)
  158.     return retval;
  159.  
  160.       for (Pix p = first (); p != 0; next (p))
  161.     {
  162.       tree_statement *elt = this->operator () (p);
  163.  
  164.       if (! print)
  165.         pf = false;
  166.       else
  167.         pf = elt->print_flag;
  168.  
  169.       tree_command *cmd = elt->command ();
  170.       tree_expression *expr = elt->expression ();
  171.  
  172.       if (cmd || expr)
  173.         {
  174.           elt->maybe_echo_code (function_body);
  175.  
  176.           if (cmd)
  177.         cmd->eval ();
  178.           else
  179.         {
  180.           if (expr->is_multi_val_ret_expression ())
  181.             {
  182.               octave_value_list args;
  183.               tree_multi_val_ret *t = (tree_multi_val_ret *) expr;
  184.               retval = t->eval (pf, nargout, args);
  185.             }
  186.           else
  187.             retval = expr->eval (pf);
  188.         }
  189.  
  190.           if (error_state)
  191.         return octave_value ();
  192.  
  193.           if (breaking || continuing)
  194.         break;
  195.  
  196.           if (returning)
  197.         break;
  198.         }
  199.       else
  200.         retval = octave_value_list ();
  201.     }
  202.       return retval;
  203.     }
  204.   else
  205.     retval = eval (print);
  206.  
  207.   return retval;
  208. }
  209.  
  210. void
  211. tree_statement_list::accept (tree_walker& tw)
  212. {
  213.   tw.visit_statement_list (*this);
  214. }
  215.  
  216. octave_value_list
  217. tree_argument_list::convert_to_const_vector (void)
  218. {
  219.   int len = length ();
  220.  
  221.   // XXX FIXME XXX -- would be nice to know in advance how largs args
  222.   // needs to be even when we have a list containing an all_va_args
  223.   // token.
  224.  
  225.   octave_value_list args;
  226.   args.resize (len);
  227.  
  228.   Pix p = first ();
  229.   int j = 0;
  230.   for (int k = 0; k < len; k++)
  231.     {
  232.       tree_expression *elt = this->operator () (p);
  233.       if (elt)
  234.     {
  235.       octave_value tmp = elt->eval (false);
  236.       if (error_state)
  237.         {
  238.           ::error ("evaluating argument list element number %d", k);
  239.           args = octave_value_list ();
  240.           break;
  241.         }
  242.       else
  243.         {
  244.           if (tmp.is_all_va_args ())
  245.         {
  246.           if (curr_function)
  247.             {
  248.               octave_value_list tva;
  249.               tva = curr_function->octave_all_va_args ();
  250.               int n = tva.length ();
  251.               for (int i = 0; i < n; i++)
  252.             args(j++) = tva(i);
  253.             }
  254.           else
  255.             {
  256.               ::error ("all_va_args is only valid inside functions");
  257.               args = octave_value_list ();
  258.               break;
  259.             }
  260.         }
  261.           else
  262.         args(j++) = tmp;
  263.         }
  264.       next (p);
  265.     }
  266.       else
  267.     {
  268.       args(j++) = octave_value ();
  269.       break;
  270.     }
  271.     }
  272.  
  273.   args.resize (j);
  274.  
  275.   return args;
  276. }
  277.  
  278. void
  279. tree_argument_list::accept (tree_walker& tw)
  280. {
  281.   tw.visit_argument_list (*this);
  282. }
  283.  
  284. // Parameter lists.
  285.  
  286. tree_parameter_list::~tree_parameter_list (void)
  287. {
  288.   while (! empty ())
  289.     {
  290.       tree_identifier *t = remove_front ();
  291.       delete t;
  292.     }
  293. }
  294.  
  295. void
  296. tree_parameter_list::mark_as_formal_parameters (void)
  297. {
  298.   for (Pix p = first (); p != 0; next (p))
  299.     {
  300.       tree_identifier *elt = this->operator () (p);
  301.       elt->mark_as_formal_parameter ();
  302.     }
  303. }
  304.  
  305. void
  306. tree_parameter_list::initialize_undefined_elements (octave_value& val)
  307. {
  308.   for (Pix p = first (); p != 0; next (p))
  309.     {
  310.       tree_identifier *elt = this->operator () (p);
  311.       if (! elt->is_defined ())
  312.     {
  313.       octave_variable_reference tmp (elt);
  314.       tmp.assign (val);
  315.     }
  316.     }
  317. }
  318.  
  319. void
  320. tree_parameter_list::define_from_arg_vector (const octave_value_list& args)
  321. {
  322.   int nargin = args.length ();
  323.  
  324.   if (nargin <= 0)
  325.     return;
  326.  
  327.   int expected_nargin = length ();
  328.  
  329.   Pix p = first ();
  330.  
  331.   for (int i = 0; i < expected_nargin; i++)
  332.     {
  333.       tree_identifier *elt = this->operator () (p);
  334.  
  335.       tree_constant *tmp = 0;
  336.  
  337.       if (i < nargin)
  338.     {
  339.       if (args(i).is_defined () && args(i).is_magic_colon ())
  340.         {
  341.           ::error ("invalid use of colon in function argument list");
  342.           return;
  343.         }
  344.       tmp = new tree_constant (args (i));
  345.     }
  346.  
  347.       elt->define (tmp);
  348.  
  349.       next (p);
  350.     }
  351. }
  352.  
  353. octave_value_list
  354. tree_parameter_list::convert_to_const_vector (tree_va_return_list *vr_list)
  355. {
  356.   int nout = length ();
  357.  
  358.   if (vr_list)
  359.     nout += vr_list->length ();
  360.  
  361.   octave_value_list retval;
  362.   retval.resize (nout);
  363.  
  364.   int i = 0;
  365.  
  366.   for (Pix p = first (); p != 0; next (p))
  367.     {
  368.       tree_identifier *elt = this->operator () (p);
  369.  
  370.       if (elt->is_defined ())
  371.     retval(i) = elt->eval (false);
  372.  
  373.       i++;
  374.     }
  375.  
  376.   if (vr_list)
  377.     {
  378.       for (Pix p = vr_list->first (); p != 0; vr_list->next (p))
  379.     {
  380.       retval(i) = vr_list->operator () (p);
  381.       i++;
  382.     }
  383.     }
  384.  
  385.   return retval;
  386. }
  387.  
  388. bool
  389. tree_parameter_list::is_defined (void)
  390. {
  391.   bool status = true;
  392.  
  393.   for (Pix p = first (); p != 0; next (p))
  394.     {
  395.       tree_identifier *elt = this->operator () (p);
  396.  
  397.       if (! elt->is_defined ())
  398.     {
  399.       status = false;
  400.       break;
  401.     }
  402.     }
  403.  
  404.   return status;
  405. }
  406.  
  407. void
  408. tree_parameter_list::accept (tree_walker& tw)
  409. {
  410.   tw.visit_parameter_list (*this);
  411. }
  412.  
  413. // Return lists.
  414.  
  415. tree_return_list::~tree_return_list (void)
  416. {
  417.   while (! empty ())
  418.     {
  419.       tree_index_expression *t = remove_front ();
  420.       delete t;
  421.     }
  422. }
  423.  
  424. void
  425. tree_return_list::accept (tree_walker& tw)
  426. {
  427.   tw.visit_return_list (*this);
  428. }
  429.  
  430. // Global.
  431.  
  432. tree_global::~tree_global (void)
  433. {
  434.   delete id;
  435.   delete ass_expr;
  436. }
  437.  
  438. void
  439. tree_global::eval (void)
  440. {
  441.   if (id)
  442.     {
  443.       id->link_to_global ();
  444.     }
  445.   else if (ass_expr)
  446.     {
  447.       tree_identifier *idnt = 0;
  448.  
  449.       if (ass_expr->left_hand_side_is_identifier_only ()
  450.       && (idnt = ass_expr->left_hand_side_id ()))
  451.     {
  452.       idnt->link_to_global ();
  453.       ass_expr->eval (false);
  454.     }
  455.       else
  456.     error ("global: unable to make individual structure elements global");
  457.     }
  458. }
  459.  
  460. void
  461. tree_global::accept (tree_walker& tw)
  462. {
  463.   tw.visit_global (*this);
  464. }
  465.  
  466. // Global initializer lists.
  467.  
  468. void
  469. tree_global_init_list::eval (void)
  470. {
  471.   for (Pix p = first (); p != 0; next (p))
  472.     {
  473.       tree_global *t = this->operator () (p);
  474.       t->eval ();
  475.     }
  476. }
  477.  
  478. void
  479. tree_global_init_list::accept (tree_walker& tw)
  480. {
  481.   tw.visit_global_init_list (*this);
  482. }
  483.  
  484. // If.
  485.  
  486. tree_if_clause::~tree_if_clause (void)
  487. {
  488.   delete expr;
  489.   delete list;
  490. }
  491.  
  492. int
  493. tree_if_clause::eval (void)
  494. {
  495.   if (is_else_clause () || expr->is_logically_true ("if"))
  496.     {
  497.       if (list)
  498.     list->eval (true);
  499.  
  500.       return 1;
  501.     }
  502.  
  503.   return 0;
  504. }
  505.  
  506. void
  507. tree_if_clause::accept (tree_walker& tw)
  508. {
  509.   tw.visit_if_clause (*this);
  510. }
  511.  
  512. // List of if commands.
  513.  
  514. void
  515. tree_if_command_list::eval (void)
  516. {
  517.   for (Pix p = first (); p != 0; next (p))
  518.     {
  519.       tree_if_clause *t = this->operator () (p);
  520.  
  521.       if (t->eval () || error_state)
  522.     break;
  523.     }
  524. }
  525.  
  526. void
  527. tree_if_command_list::accept (tree_walker& tw)
  528. {
  529.   tw.visit_if_command_list (*this);
  530. }
  531.  
  532. // Switch.
  533.  
  534. tree_switch_case::~tree_switch_case (void)
  535. {
  536.   delete label;
  537.   delete list;
  538. }
  539.  
  540. bool
  541. tree_switch_case::label_matches (const octave_value& val)
  542. {
  543.   bool retval = false;
  544.  
  545.   octave_value label_value = label->eval (false);
  546.  
  547.   if (! error_state)
  548.     {
  549.       if (label_value.is_defined ())
  550.     {
  551.       octave_value tmp = do_binary_op (octave_value::eq,
  552.                        val, label_value);
  553.  
  554.       if (! error_state)
  555.         {
  556.           if (tmp.is_defined ())
  557.         retval = tmp.is_true ();
  558.           else
  559.         eval_error ();
  560.         }
  561.       else
  562.         eval_error ();
  563.     }
  564.       else
  565.     eval_error ();
  566.     }
  567.   else
  568.     eval_error ();
  569.  
  570.   return retval;
  571. }
  572.  
  573. int
  574. tree_switch_case::eval (const octave_value& val)
  575. {
  576.   int retval = 0;
  577.  
  578.   if (is_default_case () || label_matches (val))
  579.     {
  580.       if (list)
  581.     list->eval (true);
  582.  
  583.       retval = 1;
  584.     }
  585.  
  586.   return retval;
  587. }
  588.  
  589. void
  590. tree_switch_case::eval_error (void)
  591. {
  592.   ::error ("evaluating switch case label");
  593. }
  594.  
  595. void
  596. tree_switch_case::accept (tree_walker& tw)
  597. {
  598.   tw.visit_switch_case (*this);
  599. }
  600.  
  601. // List of switch cases.
  602.  
  603. void
  604. tree_switch_case_list::eval (const octave_value& val)
  605. {
  606.   for (Pix p = first (); p != 0; next (p))
  607.     {
  608.       tree_switch_case *t = this->operator () (p);
  609.  
  610.       if (t->eval (val) || error_state)
  611.     break;
  612.     }
  613. }
  614.  
  615. void
  616. tree_switch_case_list::accept (tree_walker& tw)
  617. {
  618.   tw.visit_switch_case_list (*this);
  619. }
  620.  
  621. /*
  622. ;;; Local Variables: ***
  623. ;;; mode: C++ ***
  624. ;;; End: ***
  625. */
  626.